BST 270 Individual Project
In May 2020, the Georgia Department of Public Health posted the following plot to illustrate the number of confirmed COVID-19 cases in their hardest-hit counties over a two-week period. Health officials claimed that the plot provided evidence that COVID-19 cases were decreasing and made the argument for reopening the state.
The plot was heavily criticized by the statistical community and several media outlets for its deceptive portrayal of COVID-19 trends in Georgia. Whether the end result was due to malicious intent or simply poor judgment, it is incredibly irresponsible to publish data visualizations that obscure and distort the truth.
Data visualization is an incredibly powerful tool that can affect health policy decisions. Ensuring they are easy to interpret, and more importantly, showcase accurate insights from data is paramount for scientific transparency and the health of individuals. For this assignment you are tasked with reproducing COVID-19 visualizations and tables published by the New York Times. Specifically, you will attempt to reproduce the following for January 12th, 2022:
- New cases as a function of time with a rolling average plot - the first plot on the page (you don’t need to recreate the colors or theme)
- Table of cases and deaths - the first table on the page
- The county-level map for previous week (‘Hot spots’) - the second plot on the page (only the ‘Hot Spots’ plot)
- Table of cases by state - the second table on the page (do not need to include per 100,000, 14-day change, or fully vaccinated columns columns)
- Brief critique of reproducibility.
Data for cases and deaths can be downloaded from this NYT GitHub
repository (use us-counties.csv). Data for county
populations can be downloaded from The
US Census Bureau. We will provide code for wrangling population data
and date to plot the map in Task #3.
The project must be submitted in the form of a Jupyter notebook or RMarkdown file and corresponding compiled/knitted PDF, with commented code and text interspersed, including a brief critique of the reproducibility of each plot and table. All project documents must be uploaded to a GitHub repository each student will create within the reproducible data science organization. The repository must also include a README file describing the contents of the repository and how to reproduce all results. You should keep in mind the file and folder structure we covered in class and make the reproducible process as automated as possible.
Tips:
- In R, you can extract the number of new cases from the case totals
using the
lagfunction. In this toy example, cases records the daily total/cumulative number of cases over a two-week period. By default, the lag function simply shifts the vector of cases back by one. The number of new cases on each day is then the difference betweencasesandlag(cases).
cases = c(13, 15, 18, 22, 29, 39, 59, 61, 62, 67, 74, 89, 108, 122)
new_cases = cases - lag(cases)
new_cases## [1] NA 2 3 4 7 10 20 2 1 5 7 15 19 14- You can write your own function to calculate a seven-day rolling
average, but the
zoopackage already provides therollmeanfunction. Below, thek = 7argument tells the function to use a rolling window of seven entries.fill = NAtellsrollmeanto returnNAfor days where the seven-day rolling average can’t be calculated (e.g. on the first day, there are no days that come before, so the sliding window can’t cover seven days). That way,new_cases_7dayavgwill be the same length ascasesandnew_cases, which would come in handy if they all belonged to the same data frame.
library(zoo)
new_cases_7dayavg = rollmean(new_cases, k = 7, fill = NA)
new_cases_7dayavg## [1] NA NA NA NA 6.857143 6.714286 7.000000 7.428571
## [9] 8.571429 9.857143 9.000000 NA NA NACoding Options
Option #1
Tasks
Task #1
Create the new cases as a function of time with a rolling average plot - the first plot on the page (you don’t need to recreate the colors or theme).
Read in rolling averages data for all of US.
# Read in NYT US data (all years)
nyt <- read.csv(url("https://raw.githubusercontent.com/nytimes/covid-19-data/master/rolling-averages/us.csv"))# Plot code hereTask #2
Create the table of cases and deaths - the first table on the page, right below the figure you created in task #1. You don’t need to include tests or hospitalizations.
Read in rolling averages data for 2022 and 2021.
nyt_2021 <- read.csv(url("https://raw.githubusercontent.com/nytimes/covid-19-data/master/rolling-averages/us-counties-2021.csv"))
nyt_2022 <- read.csv(url("https://raw.githubusercontent.com/nytimes/covid-19-data/master/rolling-averages/us-counties-2022.csv"))# Code to calculate values hereTask #3
Create the county-level map for previous week (‘Hot spots’) - the second plot on the page (only the ‘Hot Spots’ plot). You don’t need to include state names and can use a different color palette.
For the map we will only use the 50 states and remove everything else. We also have to perform some string processing so we can merge the cases data frame with the map data frame.
`%!in%` <- Negate(`%in%`)
per_capita <- nyt_2022 %>%
filter(date == "2022-01-12",
state %!in% c("Puerto Rico", "American Samoa",
"Northern Mariana Islands", "Virgin Islands")) %>%
rename(region = state,
subregion = county) %>%
mutate(region = str_to_lower(region),
subregion = str_to_lower(subregion),
subregion = str_replace(subregion, "\\.", ""))
head(per_capita)## date geoid subregion region cases cases_avg cases_avg_per_100k
## 1 2022-01-12 USA-56045 weston wyoming 4 2.71 39.18
## 2 2022-01-12 USA-56043 washakie wyoming 9 6.29 80.53
## 3 2022-01-12 USA-56041 uinta wyoming 55 28.86 142.67
## 4 2022-01-12 USA-56039 teton wyoming 125 153.86 655.72
## 5 2022-01-12 USA-56037 sweetwater wyoming 46 35.86 84.68
## 6 2022-01-12 USA-56035 sublette wyoming 16 5.43 55.22
## deaths deaths_avg deaths_avg_per_100k
## 1 0 0.06 0.82
## 2 0 0.12 1.53
## 3 0 0.09 0.42
## 4 0 0.00 0.00
## 5 0 0.26 0.61
## 6 0 0.03 0.29Load the US counties map data.
library(usmap)
library(maps)##
## Attaching package: 'maps'## The following object is masked from 'package:purrr':
##
## mapcounties <- map_data("county")
head(counties)## long lat group order region subregion
## 1 -86.50517 32.34920 1 1 alabama autauga
## 2 -86.53382 32.35493 1 2 alabama autauga
## 3 -86.54527 32.36639 1 3 alabama autauga
## 4 -86.55673 32.37785 1 4 alabama autauga
## 5 -86.57966 32.38357 1 5 alabama autauga
## 6 -86.59111 32.37785 1 6 alabama autaugaJoin the two data frames. Use this data frame to create plot.
counties <- counties %>%
left_join(per_capita, by = c("region", "subregion"))
head(counties)## long lat group order region subregion date geoid cases
## 1 -86.50517 32.34920 1 1 alabama autauga 2022-01-12 USA-01001 78
## 2 -86.53382 32.35493 1 2 alabama autauga 2022-01-12 USA-01001 78
## 3 -86.54527 32.36639 1 3 alabama autauga 2022-01-12 USA-01001 78
## 4 -86.55673 32.37785 1 4 alabama autauga 2022-01-12 USA-01001 78
## 5 -86.57966 32.38357 1 5 alabama autauga 2022-01-12 USA-01001 78
## 6 -86.59111 32.37785 1 6 alabama autauga 2022-01-12 USA-01001 78
## cases_avg cases_avg_per_100k deaths deaths_avg deaths_avg_per_100k
## 1 100.29 179.5 0 0.12 0.21
## 2 100.29 179.5 0 0.12 0.21
## 3 100.29 179.5 0 0.12 0.21
## 4 100.29 179.5 0 0.12 0.21
## 5 100.29 179.5 0 0.12 0.21
## 6 100.29 179.5 0 0.12 0.21Mapping US state counties is possible using the maps
package by using map_data("county"). Here we choose a red
outline and no fill color. You will need to fill the counties with the
average number of daily cases per capita and can change the outline
color to white.
AllCounty <- map_data("county")
AllCounty %>% ggplot(aes(x = long, y = lat, group = group)) +
geom_polygon(color = "red", fill = NA, size = .1 )## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
# Code to create map here.Task #4
Create the table of cases by state - the second table on the page (do not need to include per 100,000, 14-day change, or fully vaccinated columns).
# Your code here. Task #5
Provide a brief critique of the reproducibility of the figures and tables you created in tasks 1-4.
Option #2
Tasks
Task #1
Create the new cases as a function of time with a rolling average plot - the first plot on the page (you don’t need to recreate the colors or theme).
Code to read in the data and get you started.
# Read in NYT data
# Note that this is read in using a URL but the csv can also be saved and used.
#nyt <- read.csv(url("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv"))
#dim(nyt)
#head(nyt)
nyt <- read.csv(url("https://raw.githubusercontent.com/nytimes/covid-19-data/master/rolling-averages/us-counties-2022.csv"))
dim(nyt)## [1] 1190702 10head(nyt)## date geoid county state cases cases_avg cases_avg_per_100k
## 1 2022-01-01 USA-72999 Unknown Puerto Rico 0 328.14 NA
## 2 2022-01-01 USA-72153 Yauco Puerto Rico 0 66.50 196.40
## 3 2022-01-01 USA-72151 Yabucoa Puerto Rico 0 63.13 196.30
## 4 2022-01-01 USA-72149 Villalba Puerto Rico 0 47.50 221.18
## 5 2022-01-01 USA-72147 Vieques Puerto Rico 0 7.63 91.16
## 6 2022-01-01 USA-72145 Vega Baja Puerto Rico 0 152.50 303.88
## deaths deaths_avg deaths_avg_per_100k
## 1 0 0 NA
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0# Plot code hereTask #2
Create the table of cases and deaths - the first table on the page, right below the figure you created in task #1. You don’t need to include tests or hospitalizations.
Task #3
Create the county-level map for previous week (‘Hot spots’) - the second plot on the page (only the ‘Hot Spots’ plot). You don’t need to include state names and can use a different color palette.
Code to wrangle county population data and map data.
# Get US county populations from census
county_pop <- as.data.frame(data.table::fread("https://www2.census.gov/programs-surveys/popest/datasets/2010-2019/counties/totals/co-est2019-alldata.csv"))# Wrangle data and pull population estimates from 2019
county_pop <- county_pop %>%
mutate(STNAME = str_to_lower(STNAME),
CTYNAME = str_replace(CTYNAME, "\\sCounty|\\sParish", ""),
CTYNAME = str_replace(CTYNAME, "\\.", ""),
CTYNAME = str_to_lower(CTYNAME),) %>%
select(STNAME, CTYNAME, POPESTIMATE2019) %>%
rename(region = STNAME, subregion = CTYNAME, population = POPESTIMATE2019)
head(county_pop)## region subregion population
## 1 alabama alabama 4903185
## 2 alabama autauga 55869
## 3 alabama baldwin 223234
## 4 alabama barbour 24686
## 5 alabama bibb 22394
## 6 alabama blount 57826# Load map data (US counties)
library(usmap)
library(maps)
counties <- map_data("county")
head(counties)## long lat group order region subregion
## 1 -86.50517 32.34920 1 1 alabama autauga
## 2 -86.53382 32.35493 1 2 alabama autauga
## 3 -86.54527 32.36639 1 3 alabama autauga
## 4 -86.55673 32.37785 1 4 alabama autauga
## 5 -86.57966 32.38357 1 5 alabama autauga
## 6 -86.59111 32.37785 1 6 alabama autauga# Merge map data frame and population data frame
counties <- counties %>%
left_join(county_pop, by = c("region", "subregion"))
head(counties)## long lat group order region subregion population
## 1 -86.50517 32.34920 1 1 alabama autauga 55869
## 2 -86.53382 32.35493 1 2 alabama autauga 55869
## 3 -86.54527 32.36639 1 3 alabama autauga 55869
## 4 -86.55673 32.37785 1 4 alabama autauga 55869
## 5 -86.57966 32.38357 1 5 alabama autauga 55869
## 6 -86.59111 32.37785 1 6 alabama autauga 55869# Wrangle NYT data to match counties data frame.
nyt <- nyt %>% rename(region = state,
subregion = county) %>%
mutate(region = str_to_lower(region),
subregion = str_to_lower(subregion),
subregion = str_replace(subregion, "\\.", ""),)
head(nyt)## date geoid subregion region cases cases_avg cases_avg_per_100k
## 1 2022-01-01 USA-72999 unknown puerto rico 0 328.14 NA
## 2 2022-01-01 USA-72153 yauco puerto rico 0 66.50 196.40
## 3 2022-01-01 USA-72151 yabucoa puerto rico 0 63.13 196.30
## 4 2022-01-01 USA-72149 villalba puerto rico 0 47.50 221.18
## 5 2022-01-01 USA-72147 vieques puerto rico 0 7.63 91.16
## 6 2022-01-01 USA-72145 vega baja puerto rico 0 152.50 303.88
## deaths deaths_avg deaths_avg_per_100k
## 1 0 0 NA
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 0 0# Calculate average daily cases for the plot - remember to group by region, subregion, and date. Then filter to only include the date 2022-01-12.
# Your code here# Merge your updated nyt data frame and counties data frame by joining by region and subregion. Mapping US state counties is possible using the maps
package by using map_data("county"). Here we choose a red
outline and no fill color. You will need to fill the counties with the
average number of daily cases per capita and can change the outline
color to white.
AllCounty <- map_data("county")
AllCounty %>% ggplot(aes(x = long, y = lat, group = group)) +
geom_polygon(color = "red", fill = NA, size = .1 )
Task #4
Create the table of cases by state - the second table on the page (do not need to include per 100,000, 14-day change, or fully vaccinated columns).
Task #5
Provide a brief critique of the reproducibility of the figures and tables you created in tasks 1-4.